home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Transactor
/
Transactor_17_1987_Transactor_Publishing.d64
/
textscan cp_m
< prev
next >
Wrap
Text File
|
2023-02-26
|
21KB
|
647 lines
;-------------------------------------------------
; "TEXT SCAN" FOR CP/M+ ON THE C128
; Aubrey Stanley, Nov 1986
;-------------------------------------------------
;
maclib z80 ;Z80 macro library
org 100h ;Start address
; CP/M Functions
boot equ 0 ;Warm start
bdos equ 5 ;CP/M Function Vector
dciof equ 6 ;Direct console
printf equ 9 ;Print string
coninf equ 10 ;Read console buffer
openf equ 15 ;Open file
closef equ 16 ;Close file
readf equ 20 ;Read sequential
sdmaf equ 26 ;Set DMA address
msecf equ 44 ;Multi-sector I/O
sconm equ 109 ;Set console mode
sdlmf equ 110 ;Set output delimiter
;
; File Control Block
fcb equ 5ch
fcbex equ fcb+12
fcbcr equ fcb+32
;
; Console Buffer for Find string
dmabuf equ 80h
mx equ dmabuf ;Max chars
nc equ mx+1 ;Num chars
rchar equ nc+1 ;Char string
;
; Character equates
rawinp equ 0ah ;Raw input mode
eomc equ 1ah ;End of file
cr equ 0dh ;Carriage ret
lf equ 0ah ;Line feed
tabc equ 09h ;Tab
bell equ 07h
;
; Decoded values for C128 keys
period equ 24 ; . key
plus equ 28 ; +
minus equ 27 ; -
endof equ 29 ; Cur down
bgnof equ 30 ; Cur up
nscrol equ 32 ; No scroll
number equ 31 ; 0-9
alt equ 33 ; Alt
tab equ 26 ; Tab
enter equ 25 ; Enter
help equ 34 ; Help
;
; Offsets for variables on the IX register
scroly equ 0 ; Scroll mode
stop equ 1 ; Stop scroll
dir equ 2 ; Current direction
lmit equ 3 ; Limit reached
lnum equ 4 ; Line numbering on
double equ 5 ; Double 0-9 values
cnt1 equ 6 ; Current number for scroll
cnt2 equ 7 ; Number of lines scrolled
count equ 8 ; General purpose
;
;--------------------------------------------
chksum: ;CHECKSUMS your code -
;Can be DELETED when all is well
lxi b,progend-start ;Count to check
lxiy start ;From sstart
lxi h,9170h ;Checksum excess
mvi d,0
chks: ldy e,0 ;Check loop
dad d ;...adds bytes
inxiy
dcx b
mov a,b
ora c
jrnz chks
mov a,l ;Should
ora h ;...be 0
jrz start ;Good code
mvi c,dciof ;Bad code
lxi d,'?' ;...print ?
call bdos ;...and
ret ;...exit
;END OF CHECKSUM CODE -
;-----------------------------------------------
;
start: ;Set stack and open file
sspd oldsp
lxi sp,stktop
xra a ;Init fcb
sta fcbex
sta fcbcr
lxi d,fcb
mvi c,openf
call bdos ;Open
ora a
jrz read
lxi d,opnerr ;Bad open
mvi c,printf
call bdos
finis: ;restore stack and exit
lspd oldsp
ret
;
read: ;read file
lxix pflags ;Print flags base
lxi h,0 ;Init sector count
shld line
mvi e,128 ;128 sectors to read
stx e,lmit ;Save for rloop
mvi c,msecf
call bdos ;Set multisectors
mvix 3,count ;3 reads
lxi d,fbegin ;Start of read area
call rloop ;Read up to 48K
ora a ;Check end of file
jrnz close ;...yes!
push d ;Save dma address
mvi e,48 ;Read 48 more sectors
stx e,lmit ;Save for rloop
mvi c,msecf
call bdos ;Set multisectors
pop d
mvix 1,count ;1 read
call rloop ;Read up to 6K more
close: lxi d,fcb
mvi c,closef ;Close
call bdos
;
bytes: ;Calculate total chars
lhld line ;Total sectors
mvi b,7 ;Count
byte10: dad h ;Double value
dcr b ;...7 times
jrnz byte10
lxi d,fbegin ;Start
dad d ;End
mvi a,eomc
eom: dcx h ;Find last char
cmp m
jrz eom
mov a,m
inx h
cpi lf
jrz eom10
mvi m,cr ;CR/LF at end
inx h
mvi m,lf
inx h
eom10: mvi m,eomc ;End of file char
shld fend ;End of file address
inx h
shld linbuf ;Line buffer address
jmp print ;output routine
;
rloop: ;Reads multisectors and keeps count
push d ;Save dma address
mvi c,sdmaf
call bdos ;Set dma address
lxi d,fcb
mvi c,readf
call bdos ;Read multisectors
cpi 2 ;Bad error?
jrc rlp5 ;...no!
;
badr: ;Error on read
lxi d,rderr
mvi c,printf
call bdos
lxi d,fcb
mvi c,closef ;Close
call bdos
jmp finis
;
rlp5: ora a ;More to read?
jrnz rlp6 ;No!
ldx h,lmit ;Store full count
rlp6: mov e,h ;# sectors read
mvi d,0
;
rlp10: ;sum total sectors so far
lhld line ;Current count
dad d ;Add in sectors read
shld line
pop d
cpi 1 ;End of file?
rz ;Yes!
mvi a,64 ;Next dma address
add d ;...up 128 sectors
mov d,a ;...or 16K in DE
dcrx count ;Any more reads?
jrnz rloop ;Yes, continue reading
xra a ;more bytes status
ret
;
print: ;Initialize for printing file
mvi a,40 ;40 char buffer
sta mx ;...for Find
mvix nscrol,stop ;To scroll
mvix 0,scroly ;Not continuous
mvix 0,double ;dont double count
mvix plus,dir ;Direction
mvix 0,lnum ;No line numbers
mvix 24,cnt1 ;24 lines a time
lxi h,fbegin-2 ;Store beginning
mvi m,eomc ;...of file
inx h ;...preamble
mvi m,lf
inx h
shld line ;Address of
lxi h,1 ;...first line
shld lino ;...line number
pr10: call getln ;Get next line
jrnz pr10 ;...until limit
lhld lino ;Store last line's
shld endln ;...line number
lxi h,fbegin ;Start with
shld line ;...first line
lxi h,1
shld lino
mvix 0,lmit ;Clear limit
mvi e,lf ;Set LF
mvi c,sdlmf ;...delimiter
call bdos ;...for output
lxi d,rawinp ;Console mode
mvi c,sconm ;...set
call bdos
call clear ;Clear screen
;
ploop: ;Print loop controls output to screen
ldx a,cnt1 ;Lines to output
stx a,cnt2
plp10: call getkey ;Conditions output
lxi d,sfwd ;Forward
ldx a,dir ;...direction
ora a
jrnz plp12
lxi d,sbak ;Backward
plp12: mvi c,printf ;Outp insert or delete
call bdos ;...line string
ldx a,lnum ;Check line
ora a ;...numbering
cnz numout ;...on and output num
call buflin ;Expand line in buffer
lded linbuf ;Line buffer address
mvi c,printf ;Output
call bdos ;...line
plp18: call getln ;Get next line pointer
ldx a,lmit ;Check file limit
ora a ;...reached
jrz plp20 ;No!
mvix 0,stop ;Stop output
jr plp10
plp20: dcrx cnt2 ;Count down
jrnz plp10
mvix 0,stop ;Count expired..stop
jr ploop
; Actions key input...loops until Stop cleared
getkey: ;input routine
call kscan ;Scan 128 keys
ora a
jrz gkg60 ;No press
cpi number ;Line Feed?
jrnz gk20
xorx lnum ;Toggle line
stx a,lnum ;...number flag
jr gk48
;
gk20: cpi tab ;Tab?
jrnz gk22
call upln ;Advance line
jr gk48 ;...position
gk22: cpi alt ;Alt?
jrnz gk30
xorx double ;Toggle
stx a,double ;...double flag
call sound ;Sound bell
jr gkg60
;
gk30: cpi enter ;Enter?
jrz gk48 ;Yes!
jrnc gk36 ;Not a number key!
cpi 11 ;Period key..24 lines?
jrnc gk34 ;Yes!
mov b,a
ldx a,double ;Double flag?
ora a
mov a,b
jrz gk34
add a ;Double 1-(1)0
gk34: stx a,cnt1 ;New output count
jr gk48
gk36: cpi nscrol ;No Scroll?
jrnz gk40
xorx scroly ;Toggle
stx a,scroly ;...scroll flag
gkg60: jr gk60
;
gk40: cpi bgnof ;Curs Up?
jrnz gk44
mvix plus,dir ;Scroll up direction
lxi h,fbegin ;First line
shld line ;...address
lxi h,1 ;Line 1
jr gk46
gk44: cpi endof ;Curs Down?
jrnz gk50
mvix 0,dir ;Scroll down dir
lhld fend ;End of file address
lxi b,2000 ;Max length of line
call upm02 ;Go back 1 to last line
lhld endln ;Last line number
gk46: shld lino ;Line number
gk47: call clear ;Clear screen
mvix 0,lmit ;Clear limit condition
gk48: ldx a,cnt1 ;New count
stx a,cnt2
jr gk64
;
gk50: cpi help ;Help?
jrnz gk52
call find ;Find input string
jrnz gk47
mvix 1,cnt2 ;1 line outut
mvix 0,scroly ;Clear scroll flag
jr gk64
gk52: cpi minus ;Minus?
jrnz gk54 ;No, must be Plus!
xra a
gk54: ldx b,dir ;Update direction
stx a,dir
cmp b
jrz gk62
jr gk47 ;Direction changed
;
gk60: ldx a,scroly ;Check scroll on
ora a
jrz gk70 ;No!
;
gk62: mvix 1,cnt2 ;Feed ongoing count
gk64: ldx a,lmit ;Check limit reached
ora a
jrnz gk70 ;Yes!
mvix nscrol,stop ;Clear stop condition
;
gk70: ldx a,stop ;If stop condition
ora a ;...then
jz getkey ;...loop until clear
ret
;
upln: ;Advance 24 lines
ldx a,lmit ;Dont advance
ora a ;...if
rnz ;...on limit
mvix 25,count
upln1: dcrx count
cnz getln ;Get next line
jrnz upln1 ;Not on limit
mvix 0,lmit ;Clear limit if set to
ret ;...dsp 1st/last line
;
getln: ;Get next line
lhld line ;Line address
lxi b,2000 ;Max length
ldx a,dir ;Check direction
ora a
jrz upmin
;
uplus: mvi a,lf ;Search char
lxi d,1
ccir ;Find next line
mvi a,eomc ;Reached limit
cmp m
jrnz upm10 ;No!
upp10: mvix 1,lmit ;Return limit
ret ;...set
;
upmin: lda lino+1 ;Check
ora a ;...if
jrnz upm02 ;...on
lda lino ;...first
cpi 1 ;...line
jrz upp10 ;Yes!
upm02: dcx h
dcx h
mvi a,lf
lxi d,-1
ccdr ;Find previous line
inx h
inx h
upm10: shld line ;New line address
mvix 0,lmit ;Clear limit
lhld lino ;Update
dad d ;...line
shld lino ;...number
mvi a,1 ;Return
ora a ;...good
ret ;condition
;
;
numout: ;Output line number
lxiy linasc ;Base for string
lhld lino ;Line number
lxi d,-10000 ;Ten thousands
call toasc ;Convert to ASCII
lxi d,-1000 ;Thousands
call toasc
lxi d,-100 ;Hundreds
call toasc
lxi d,-10 ;Tens
call toasc
mov a,l ;0 - 9
adi '0'
sty a,0
lxi d,linasc
mvi c,printf ;Print string
call bdos
ret
;
toasc: mvi c,'0'-1
toas1: inr c
dad d
jc toas1
mov a,d
cma
mov d,a
mov a,e
cma
mov e,a
inx d
dad d
sty c,0
inxiy
ret
;
buflin: ;Prepare line for output
lbcd line ;Current line address
lhld linbuf ;Line buffer address
bufl10: mvix 8,count ;Tab count
bufl12: ldax b
inx b
cpi 20h ;Trap control char
jrnc bufl16 ;Not one
cpi cr ;Carriage return?
jrz bufl16
cpi lf ;Line feed?
jrz bufl16
cpi tabc ;Check if tab
jrnz bufl15 ;No!
bufl14: mvi m,' ' ;Expand tab
inx h
dcrx count
jrnz bufl14
jr bufl10
bufl15: mvi m,'^' ;Convert control char
inx h ;...to two chars
ori 40h ;...for display
bufl16: mov m,a ;Normal char
inx h
cpi lf ;Line feed
rz ;...ends line
dcrx count
jrz bufl10
jr bufl12
;
find: ;Search Input String function
call kscan ;loop until
lda ktable ;...help
ora a ;...key is
jrnz find ;...released
call revrse ;direction
call getln ;adjust line params
call revrse
lxi d,cbot ;Bottom line
ldx a,dir ;Check direction
ora a
jrnz find02
lxi d,ctop ;Top line
find02: mvi c,printf ;Clear line
call bdos
lxi d,dmabuf ;Buffer for input
mvi c,coninf ;Get input string
call bdos
lda nc ;Check char count
ora a
rz ;Empty string
stx a,count
lhld lino ;Save
shld tempn ;...current line
lhld line ;...params in case
shld templ ;...no match
find10: lbcd line ;Begin search loop
find12: mvi e,0
lxi h,rchar
find14: ldax b
cmp m
inx h
inx b
jrnz find16
inr e
mov a,e
cmpx count
jrnz find14
jr sound ;String found
find16: cpi lf
jrnz find12
call getln
jrnz find10
find20: lhld templ ;Limit reached
shld line ;...so
lhld tempn ;...restore
shld lino ;...original line
mvix 0,lmit ;Clear limit
ret
;
sound: ;Bell
mvi c,dciof
lxi d,bell
call bdos
mvi a,1
ora a
ret
;
revrse: ;Reverse current direction
mvi a,plus
xorx dir
stx a,dir
ret
;
clear: ;Clear Screen
lxi d,clr
mvi c,printf
call bdos
ret
;
kscan: ;Scan C128 Keys
di
lxi h,ktable ;Key press/change table
lxi b,0dc00h ;Key matrix drives for
mvi d,0ffh ;...C64 keys are
outp d ;...are disabled
mvi d,0feh ;Drive one row
mvi e,3 ;...of three
kscn2: lxi b,0d02fh ;Drives for
outp d ;...C128 keys
lxi b,0dc01h ;To read row
kscn3: inp a ;Read keys
push h ;A little delay
inp h ;...helps along the way!
cmp h ;Debounce
pop h
jrnz kscn3 ;Check again
cma ;Make 1's of presses
mov b,m ;Previous keys
mov m,a ;New keys
xra b ;...gives changes
ana m ;...and pressed changes
inx h
mov m,a ;Save pressed changes
inx h ;Now for
rlcr d ;...next row
dcr e
jrnz kscn2
;
kchng: ;Process Changes
ei
lxi h,ktable+2 ;First
mov a,m ;...check
ani 1 ;...ESC?
jrz kchg1
call clear ;Clear screen
jmp finis ;...and exit
kchg1: mov a,m
ani 06h ;+/- presses?
inx h
jrz kchg2
ora m ;Force a change
mov m,a
kchg2: inx h
inx h
mvi c,3 ;Count
kchg3: mov a,m ;Pressed changes
cma
inr a
ana m ;Extract one change
jnz kchg10 ;Found one
dcx h ;Goto next row
dcx h
dcr c
jrnz kchg3
ret ;No changes found
;
kchg10: ;Decode Change
lxi h,dtable ;Key Decode table
lxi d,8
kchg12: dcr e
add a
jrnc kchg12
dad d
mvi e,8
kchg14: dcr c
jrz kchg20
dad d
jr kchg14
kchg20: mov a,m ;Decoded value
ret
;
dtable: ;Key Decode Table
db help,08,05,tab,02,04,07,01
db 00,plus,minus,number,enter,06,09,03
db alt,10,24,bgnof,endof,00,00,nscrol
;
ktable: ;Key Press/Change Table: rows 1-3
db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
opnerr: db cr,lf,'no file$'
rderr: db cr,lf,'bad read error$'
;
sfwd: db 1bh,3dh,20h,20h,1bh,52h,1bh,3dh,37h,20h,0ah
sbak: db 1bh,3dh,20h,20h,1bh,45h,0ah
ctop: db 1bh,3dh,20h,20h,1bh,54h,0ah
cbot: db 1bh,3dh,37h,20h,1bh,54h,0ah
clr: db 1ah,0ah
linasc: db '00000: ',0ah
;
progend equ $ ;Used for checksum on code
;
fend: ds 2 ;File end address
linbuf: ds 2 ;Line buffer address
line: ds 2 ;Current line address
lino: ds 2 ;Current line number
endln: ds 2 ;Last line number
templ: ds 2 ;Work area
tempn: ds 2 ;Work area
pflags: ds 10 ;IX register variables
oldsp: ds 2 ;Saved stack
ds 128 ;Program stack
stktop equ $
;
fbegin equ 800h ;Text file loads here
;
end